home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / apg_2.exe / MAINT.SKL < prev    next >
Text File  |  1993-02-20  |  18KB  |  746 lines
  1. XX ''''''''''''''''''''''''''''''''''''''''''''''''''
  2. XX '                                                '
  3. XX '                    INVENTORY                   '
  4. XX '                                                '
  5. XX '                 CREATED BY APG                 '
  6. XX '                                                '
  7. XX '                 S & M SOFTWARE                 '
  8. XX '                                                '
  9. XX '                 COPYRIGHT 1993                 '
  10. XX '                                                '
  11. XX '                                                '
  12. XX '  Author: John N Shankland                      '
  13. XX '  Date:   01-28-1993                            '
  14. XX '  Time:   10:43:36                              '
  15. XX '                                                '
  16. XX ''''''''''''''''''''''''''''''''''''''''''''''''''
  17.  
  18. DEFINT A-Z
  19. CONST FALSE = 0, TRUE = NOT FALSE
  20. TYPE rectype                                'Define variables for file
  21. XX    inbr AS STRING * 10
  22. XX    desc AS STRING * 30
  23. XX    num1 AS DOUBLE
  24. XX    num2 AS INTEGER
  25. XX    num3 AS SINGLE
  26. XX    num4 AS SINGLE
  27.    sts AS STRING * 1
  28. END TYPE
  29. TYPE indextype                              'Define index
  30.    recnum AS INTEGER
  31. XX    inbr AS STRING * 10
  32. END TYPE
  33. DECLARE FUNCTION getinput$ (work$, fl%, nflg$, plen, prec, form$, act$, mode$)
  34. DECLARE SUB arrow (mode$, opt$, tracfld)
  35. DECLARE SUB clearfore ()
  36. DECLARE SUB displaydata ()
  37. DECLARE SUB export ()
  38. DECLARE SUB message (msg$, resp$)
  39. DECLARE SUB newrec (recnum, numofrec, maxrec, newkey$, exit$, mode$)
  40. DECLARE SUB nextrec (direc$, exit$, numofrec, recnum)
  41. DECLARE SUB sortindex ()
  42. DIM SHARED numofrec
  43. XX DIM SHARED f7.2$
  44. XX DIM SHARED f4.0$
  45. XX DIM SHARED f2.2$
  46. XX DIM SHARED f0.3$
  47. XX DIM SHARED inv AS rectype
  48. XX f7.2$ = "########.##"
  49. XX f4.0$ = "#####"
  50. XX f2.2$ = "###.##"
  51. XX f0.3$ = "#.###"
  52.  
  53. ON ERROR GOTO errhandle
  54.  
  55. COLOR 15, 0
  56. CLS
  57.  
  58. XX OPEN "inv.dat" FOR RANDOM AS #1 LEN = LEN(inv)
  59.  
  60. XX numofrec = LOF(1) \ LEN(inv)
  61. maxrec = numofrec + 100
  62. DIM SHARED index(1 TO maxrec)  AS indextype
  63. IF numofrec <> 0 THEN
  64.    FOR recnum = 1 TO numofrec
  65. XX       GET #1, recnum, inv
  66.       index(recnum).recnum = recnum
  67. XX index(recnum).inbr = inv.inbr
  68.    NEXT
  69. END IF
  70. '
  71. '----- Print menu -----'
  72. '
  73. XX LOCATE 1, 35
  74. COLOR 7, 9
  75. XX PRINT " INVENTORY " '
  76. XX LOCATE 2, 35
  77. XX PRINT "MAINTENANCE" '
  78. sortindex                                   'sort records
  79. recnum = 0                                  'reset record number
  80.  
  81. XX LOCATE 4, 10: PRINT "01-Item number "
  82. XX LOCATE 6, 5: PRINT "02-Description      "
  83. XX LOCATE 7, 5: PRINT "03-num 7.2          "
  84. XX LOCATE 8, 5: PRINT "04-num 4.0          "
  85. XX LOCATE 9, 5: PRINT "05-num 2.2          "
  86. XX LOCATE 10, 5: PRINT "06-num 4 0.3        "
  87. '
  88. '----- Start processing -----'
  89. '
  90. start:
  91. mode$ = ""
  92. XX inv.inbr = ""
  93. XX inv.desc = ""
  94. XX inv.num1 = 0
  95. XX inv.num2 = 0
  96. XX inv.num3 = 0
  97. XX inv.num4 = 0
  98. XX inv.sts = ""
  99. nflg$ = ""
  100. clearfore
  101. XX LOCATE 4, 26
  102. XX newkey$ = getinput$(inv.inbr, 10, "S", 0, 0, "", act$, mode$)
  103. IF act$ = "PU" OR act$ = "PD" THEN
  104.    opt$ = act$
  105.    IF recnum = 0 THEN
  106.       IF opt$ = "PU" AND numofrec <> 0 THEN recnum = numofrec + 1
  107.    END IF
  108.    GOTO menu10
  109. END IF
  110. XX IF newkey$ = "          " GOTO fin
  111. XX IF UCASE$(newkey$) = "N         " THEN
  112.    opt$ = "N"
  113.    GOTO menu10
  114. END IF
  115. GOTO io
  116. '
  117. '------ Option bar -----'
  118. '
  119. menu:
  120. mode$ = "C"
  121. LOCATE 23, 1
  122. PRINT STRING$(80, " ")
  123. LOCATE 23, 12, 1
  124. COLOR 7, 9
  125. PRINT "FIELD #, PgUp, PgDn, ";
  126. PRINT "All, Next, Back, Delete, Sort, Export";
  127. COLOR 15, 0
  128. PRINT "  "
  129. COLOR 15, 9
  130. LOCATE 23, 18: PRINT "#"
  131. LOCATE 23, 33: PRINT "A"
  132. LOCATE 23, 38: PRINT "N"
  133. LOCATE 23, 44: PRINT "B"
  134. LOCATE 23, 50: PRINT "D"
  135. LOCATE 23, 58: PRINT "S"
  136. LOCATE 23, 64: PRINT "E"
  137.  
  138. COLOR 15, 0
  139. opt$ = ""
  140. menu5:
  141. LOCATE 23, 71
  142. PRINT opt$;
  143. DO
  144. instr$ = INKEY$
  145. LOOP WHILE instr$ = ""
  146.  
  147. IF INSTR("BANDSE", UCASE$(instr$)) > 0 THEN opt$ = instr$: GOTO menu10
  148. IF instr$ = CHR$(13) GOTO menu10
  149. IF instr$ = CHR$(27) GOTO menu
  150. IF instr$ = CHR$(8) GOTO menu
  151. IF LEN(instr$) = 2 THEN
  152.    code = ASC(RIGHT$(instr$, 1))
  153.    IF code = &H49 THEN opt$ = "PU"
  154.    IF code = &H51 THEN opt$ = "PD"
  155.    GOTO menu10
  156. END IF
  157. opt$ = opt$ + instr$
  158. GOTO menu5
  159. '
  160. '----- Start here for action keys -----'
  161. '
  162. menu10:  
  163. resp$ = ""
  164. IF opt$ = "" THEN GOTO start
  165. opt$ = UCASE$(opt$)
  166. IF MID$(opt$, 1, 1) = "0" THEN opt$ = MID$(opt$, 2, 1)
  167. LOCATE 23, 1
  168. PRINT STRING$(80, " ")
  169. LOCATE 23, 6, 1
  170. COLOR 7, 9
  171. IF INSTR("SEBNPUPD", opt$) = 0 THEN
  172. PRINT "Active Keys: <PgUp>, <PgDn>, <Arrows>, <Del>, <Ins>, <Esc> or <Enter>";
  173. COLOR 15, 9
  174. LOCATE 23, 20: PRINT "PgUp";
  175. LOCATE 23, 28: PRINT "PgDn";
  176. LOCATE 23, 36: PRINT "Arrows";
  177. LOCATE 23, 46: PRINT "Del";
  178. LOCATE 23, 53: PRINT "Ins";
  179. LOCATE 23, 60: PRINT "Esc";
  180. LOCATE 23, 69: PRINT "Enter";
  181. END IF
  182. COLOR 15, 0
  183.  
  184. SELECT CASE opt$
  185.    CASE "1"
  186.       message "Can not change index - Press any key", resp$
  187.       GOTO menu
  188. XX    CASE "2"                                 'Description
  189. XX       GOTO fld20
  190. XX    CASE "3"
  191. XX       GOTO fld30
  192. XX    CASE "4"
  193. XX       GOTO fld40
  194. XX    CASE "5"
  195. XX       GOTO fld50
  196. XX    CASE "6"
  197. XX       GOTO fld60
  198.    CASE "A"
  199.       mode$ = "A"
  200.       GOTO fld20
  201.    CASE "N", "PD"
  202.       direc$ = "F"
  203.       nextrec direc$, exit$, numofrec, recnum
  204.       IF exit$ = "A" GOTO start
  205.       GOTO menu
  206.    CASE "B", "PU"
  207.       direc$ = "B"
  208.       nextrec direc$, exit$, numofrec, recnum
  209.       IF exit$ = "A" GOTO start
  210.       GOTO menu
  211.    CASE "D"
  212. XX inv.sts = "D"
  213.       GOTO del
  214.    CASE "S"
  215.       resp$ = "1"
  216.       message "Sorting file - Please wait", resp$
  217.       sortindex
  218.       resp$ = "2"
  219.       message "", resp$
  220.    CASE "E"
  221.       CLOSE (2)
  222. XX KILL "john.exp"
  223.       resp$ = "1"
  224.       message "Preparing file for export - Please wait", resp$
  225.       export
  226.       resp$ = "2"
  227.       message "", resp$
  228. XX GET #1, recnum, john
  229. END SELECT
  230. GOTO menu
  231. '
  232. '----- Input fields -----'
  233. '
  234. XX fld20:                                 ' Description
  235. XX tracfld = 2
  236. XX LOCATE 6, 26
  237. XX inv.desc = getinput$(inv.desc, 30, "S", 0, 0, "", act$, mode$)
  238. XX LOCATE 25, 1
  239. XX PRINT STRING$(80, " ");
  240. XX IF inv.desc = "                              " AND mode$ <> "C" THEN
  241. XX    GOTO start
  242. XX END IF
  243. XX IF mode$ = "C" OR act$ <> "" GOTO add
  244. XX
  245. XX fld30:
  246. XX tracfld = 3
  247. XX LOCATE 7, 26
  248. XX IF mode$ = "N" THEN
  249. XX num1$ = STRING$(11, " ")
  250. XX ELSE
  251. XX num1$ = STR$(inv.num1) + STRING$(11, " ")
  252. XX END IF
  253. XX inv.num1 = VAL(getinput$(num1$, 11, "N", 7, 2, f7.2$, act$, mode$))
  254. XX IF mode$ = "C" OR act$ <> "" GOTO add
  255. XX
  256. XX fld40:
  257. XX tracfld = 4
  258. XX LOCATE 8, 26
  259. XX IF mode$ = "N" THEN
  260. XX num2$ = STRING$(6, " ")
  261. XX ELSE
  262. XX num2$ = STR$(inv.num2) + STRING$(6, " ")
  263. XX END IF
  264. XX inv.num2 = VAL(getinput$(num2$, 6, "N", 4, 0, f4.0$, act$, mode$))
  265. XX IF mode$ = "C" OR act$ <> "" GOTO add
  266. XX
  267. XX fld50:
  268. XX tracfld = 5
  269. XX LOCATE 9, 26
  270. XX IF mode$ = "N" THEN
  271. XX num3$ = STRING$(6, " ")
  272. XX ELSE
  273. XX num3$ = STR$(inv.num3) + STRING$(6, " ")
  274. XX END IF
  275. XX inv.num3 = VAL(getinput$(num3$, 6, "N", 2, 2, f2.2$, act$, mode$))
  276. XX IF mode$ = "C" OR act$ <> "" GOTO add
  277. XX
  278. XX fld60:
  279. XX tracfld = 6
  280. XX LOCATE 10, 26
  281. XX IF mode$ = "N" THEN
  282. XX num4$ = STRING$(5, " ")
  283. XX ELSE
  284. XX num4$ = STR$(inv.num4) + STRING$(5, " ")
  285. XX END IF
  286. XX inv.num4 = VAL(getinput$(num4$, 5, "N", 0, 3, f0.3$, act$, mode$))
  287. XX IF mode$ = "C" OR act$ <> "" GOTO add
  288. '
  289. '----- Add or change record or field -----'
  290. '
  291. add:                                        'Add record
  292. newrec recnum, numofrec, maxrec, newkey$, exit$, mode$
  293. IF exit$ = "Y" THEN GOTO fin
  294. IF act$ = "" GOTO menu
  295. IF act$ = "PD" THEN direc$ = "F"
  296. IF act$ = "PU" THEN direc$ = "B"
  297. IF act$ = "PD" OR act$ = "PU" THEN
  298.    nextrec direc$, exit$, numofrec, recnum
  299.    IF exit$ = "A" GOTO start
  300.    GOTO menu10
  301. END IF
  302. IF mode$ = "N" THEN mode$ = "Z"
  303. IF act$ = "AU" THEN
  304.    IF tracfld - 1 < 2 THEN
  305.       BEEP
  306.       tracfld = 3
  307.    END IF
  308.    opt$ = MID$(STR$(tracfld - 1), 2)
  309.    GOTO menu10
  310. END IF
  311. IF act$ = "AD" THEN
  312. XX    IF tracfld + 1 > 6 THEN
  313.       BEEP
  314. XX tracfld = 5
  315.    END IF
  316.    opt$ = MI